home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / UTILS.ASM < prev    next >
Encoding:
Assembly Source File  |  1993-05-19  |  19.1 KB  |  684 lines
  1. ;* UTILS.ASM
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Borland TASM code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*        Utilities, including C--Asm linkages            *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: John Jensen        Date: 1985            *
  16. ;* Revision history:                            *
  17. ;* - 25 Feb 86:    Added the routine "put_ptr" to combine the        *
  18. ;*    "put_byte/put_word" operations when a pointer is being stored    *
  19. ;*    into memory. (JCJ)                        *
  20. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  21. ;*                                    *
  22. ;*                    ``In nomine omnipotentii dei''    *
  23. ;************************************************************************
  24. IDEAL
  25. %PAGESIZE    60, 132
  26. MODEL    medium
  27. LOCALS    @@
  28.  
  29.     INCLUDE    "scheme.ash"
  30.  
  31. CODESEG
  32.  
  33. ;************************************************************************
  34. ;* Zero a page in memory - Calling sequence: zero_page(page_no)        *
  35. ;************************************************************************
  36. PROC C    zero_page USES di, @@page:WORD
  37.     mov    bx, [@@page]
  38.     sal    bx, 1
  39.     ldpage    es, bx
  40.     xor    ax, ax
  41.     xor    di, di
  42.     mov    cx, [psize+bx]
  43.     shr    cx, 1
  44.     cld
  45.     rep    stosw
  46.     ret
  47. ENDP    zero_page
  48.  
  49. ;************************************************************************
  50. ;* Zero a block of memory                        *
  51. ;*                                    *
  52. ;* Purpose: To initialize a variable length block of memory to zero.    *
  53. ;*                                    *
  54. ;* Description:    The block is zeroed using the 8088's "store string"    *
  55. ;*            instruction using a repeat count. For        *
  56. ;*            efficiency reasons, the zeroing is done by    *
  57. ;*            words, with a fixup to account for blocks with    *
  58. ;*            an odd number of bytes.                *
  59. ;*                                    *
  60. ;* Calling sequence: zero_blk(page_no, disp)                *
  61. ;*    where page_no = page number (C's unshifted page number)        *
  62. ;*            disp    = displacement of block within the page    *
  63. ;************************************************************************
  64. PROC C    zero_blk USES di, @@page:WORD, @@disp:WORD
  65.     mov    bx, [@@page]
  66.     shl    bx, 1            ; and adjust for use as index
  67.     mov    di, [@@disp]
  68.     ldpage    es, bx
  69.     mov    cx, [(ANYDEF es:di).len]
  70.     add    di, OFFSET (TYPE ANYDEF).data
  71.     or    cx, cx
  72.     jge    @@bigstring
  73.     add    cx, SIZE POINTER
  74.     jmp    @@cont
  75. @@bigstring:
  76.     sub    cx, OFFSET (TYPE ANYDEF).data
  77. @@cont:
  78.     xor    ax, ax        ; load a value of zero into ax
  79.     shr    cx, 1        ; convert number of bytes to number of words
  80.     cld
  81.     rep    stosw
  82.     jnc    @@even
  83.     stosb            ; zero the last byte, if odd number of bytes
  84. @@even:
  85.     ret
  86. ENDP    zero_blk
  87.  
  88. ;************************************************************************
  89. ;*        Use a Scheme page in C                    *
  90. ;*    Calling sequence:                        *
  91. ;*        LIST    far *p;                        *
  92. ;*        p = (LIST far *) page2c(page);                *
  93. ;*        where:    page ----- page #                *
  94. ;*            p[n] ----- n+1st list cell in the page        *
  95. ;************************************************************************
  96. PROC C    page2c, @@page:WORD
  97.     mov    bx, [@@page]
  98.     shl    bx, 1            ; adjust it for segment lookup
  99.     ldpage    ax, bx
  100.     ret
  101. ENDP    page2c
  102.  
  103. PROC C    scheme2c, @@page:WORD, @@disp:WORD
  104.     mov    bx, [@@page]
  105.     shl    bx, 1            ; adjust it for segment lookup
  106.     ldpage    dx, bx
  107.     mov    ax, [@@disp]
  108.     ret
  109. ENDP    scheme2c
  110.  
  111. PROC C    reg2c, @@reg:WORD
  112.     mov    bx, [@@reg]
  113.     ldpage    dx, [(REG bx).page]
  114.     mov    ax, [(REG bx).disp]
  115.     ret
  116. ENDP    reg2c
  117.  
  118. ;************************************************************************
  119. ;        Get a register's type
  120. ;    Calling sequence:    data = gettype(reg)
  121. ;************************************************************************
  122. PROC C    gettype, @@reg:WORD, @@disp:WORD
  123.     mov    bx, [@@reg]
  124.     mov    bx, [(REG bx).page]
  125.     mov    ax, [WORD ptype+bx]
  126.     ret
  127. ENDP    gettype
  128.  
  129. ;************************************************************************
  130. ;        Get a byte of data
  131. ;    Calling sequence:        data = get_byte(page, disp)
  132. ;        where:    page ----- page number
  133. ;            disp ----- (byte) displacement within page
  134. ;************************************************************************
  135. PROC C    get_byte, @@page:WORD, @@disp:WORD
  136.     mov    bx, [@@page]
  137.     shl    bx, 1            ; adjust it for segment lookup
  138.     ldpage    es, bx
  139.     mov    bx, [@@disp]
  140.     mov    al, [BYTE es:bx]
  141.     xor    ah, ah            ; and only a byte
  142.     ret
  143. ENDP    get_byte
  144.  
  145. ;************************************************************************
  146. ;        Get a word of data
  147. ;    Calling sequence:        data = get_word(page, disp)
  148. ;        where:    page ----- page number
  149. ;            disp ----- (byte) displacement within page
  150. ;************************************************************************
  151. PROC C    get_word, @@page:WORD, @@disp:WORD
  152.     mov    bx, [@@page]
  153.     shl    bx, 1            ; adjust it for segment lookup
  154.     ldpage    es, bx
  155.     mov    bx, [@@disp]
  156.     mov    ax, [WORD es:bx]
  157.     ret
  158. ENDP    get_word
  159.  
  160. ;************************************************************************
  161. ;        Put a byte of data
  162. ;    Calling sequence:        put_byte(page, disp, value)
  163. ;        where:    page ----- page number
  164. ;            disp ----- (byte) displacement within page
  165. ;            value ---- value to be stored (low order 8 bits)
  166. ;************************************************************************
  167. PROC C    put_byte, @@page:WORD, @@disp:WORD, @@val:WORD
  168.     mov    bx, [@@page]
  169.     shl    bx, 1            ; adjust it for segment lookup
  170.     ldpage    es, bx
  171.     mov    bx, [@@disp]
  172.     mov    ax, [@@val]
  173.     mov    [BYTE es:bx], al
  174.     ret
  175. ENDP    put_byte
  176.  
  177. ;************************************************************************
  178. ;        Put a word of data
  179. ;    Calling sequence:        put_word(page, disp, value)
  180. ;        where:    page ----- page number
  181. ;            disp ----- (byte) displacement within page
  182. ;            value ---- value to be stored (16 bits)
  183. ;************************************************************************
  184. PROC C    put_word, @@page:WORD, @@disp:WORD, @@val:WORD
  185.     mov    bx, [@@page]
  186.     shl    bx, 1        ; adjust it for segment lookup
  187.     ldpage    es, bx
  188.     mov    bx, [@@disp]
  189.     mov    ax, [@@val]
  190.     mov    [WORD es:bx], ax
  191.     ret
  192. ENDP    put_word
  193.  
  194. ;************************************************************************
  195. ;        Put a pointer
  196. ;    Calling sequence:        put_word(page, disp, pg_value, ds_value)
  197. ;        where:    old_data - original data (overwritten)
  198. ;            page ----- page number
  199. ;            disp ----- (byte) displacement within page
  200. ;            pg_value ---- value of page number to store (16 bits)
  201. ;            ds_value ---- value of displacement to store (16 bits)
  202. ;************************************************************************
  203. PROC C    put_ptr, @@page:WORD, @@disp:WORD, @@ptpage:WORD, @@ptdisp:WORD
  204.     mov    bx, [@@page]
  205.     sal    bx, 1
  206.     ldpage    es, bx
  207.     mov    bx, [@@disp]
  208.     mov    ax, [@@ptpage]
  209.     mov    [(POINTER es:bx).page], al
  210.     mov    ax, [@@ptdisp]
  211.     mov    [(POINTER es:bx).disp], ax
  212.     ret
  213. ENDP    put_ptr
  214.  
  215. ;************************************************************************
  216. ;*            get_str, get_sym                *
  217. ;************************************************************************
  218. PROC C    get_str USES ds si di, @@ptr:WORD, @@page:WORD, @@disp:WORD
  219.     push    ds            ; Assume es = ds
  220.     pop    es
  221.     mov    di, [@@ptr]
  222.     mov    bx, [@@page]
  223.     shl    bx, 1            ; Adjust page number for use as index
  224.     ldpage    ds, bx
  225.     mov    si, [@@disp]
  226.     sstrlen    cx, <si>
  227.     lea    si, [(STRDEF si).buffer]
  228.     cld
  229.     rep    movsb
  230.     ret
  231. ENDP    get_str
  232.  
  233. PROC C    get_sym USES ds si di, @@ptr:WORD, @@page:WORD, @@disp:WORD
  234.     push    ds            ; Assume es = ds
  235.     pop    es
  236.     mov    di, [@@ptr]
  237.     mov    bx, [@@page]
  238.     shl    bx, 1            ; Adjust page number for use as index
  239.     ldpage    ds, bx
  240.     mov    si, [@@disp]
  241.     mov    cx, [(SYMDEF si).len]
  242.     add    si, OFFSET (TYPE SYMDEF).buffer
  243.     sub    cx, OFFSET (TYPE SYMDEF).buffer
  244.     cld
  245.     rep    movsb
  246.     ret
  247. ENDP    get_sym
  248.  
  249. ;************************************************************************
  250. ;*            put_str, put_sym                *
  251. ;************************************************************************
  252. PROC C    put_str    USES si di, @@ptr:WORD, @@page:WORD, @@disp:WORD
  253.     mov    bx, [@@page]
  254.     shl    bx, 1        ; Adjust page number for use as index
  255.     ldpage    es, bx
  256.     mov    si, [@@ptr]
  257.     mov    di, [@@disp]
  258.     sstrlen    cx, <es:di>
  259.     lea    di, [(STRDEF es:di).buffer]
  260.     cld
  261.     rep    movsb
  262.     ret
  263. ENDP    put_str
  264.  
  265. PROC C    put_sym    USES si di, @@ptr:WORD, @@page:WORD, @@disp:WORD, @@linkpage:WORD, @@linkdisp:WORD, @@hashkey:WORD
  266.     mov    bx, [@@page]
  267.     shl    bx, 1            ; Adjust page number for use as index
  268.     ldpage    es, bx
  269.     mov    si, [@@ptr]
  270.     mov    di, [@@disp]
  271.     mov    dx, [@@linkpage]
  272.     mov    ax, [@@linkdisp]
  273.     mov    [(SYMDEF es:di).link.page], dl
  274.     mov    [(SYMDEF es:di).link.disp], ax
  275.     mov    ax, [@@hashkey]
  276.     mov    [(SYMDEF es:di).hashkey], al
  277.  
  278.     mov    cx, [(SYMDEF es:di).len]
  279.     lea    di, [(SYMDEF es:di).buffer]
  280.     sub    cx, OFFSET (TYPE SYMDEF).buffer
  281.     cld
  282.     rep    movsb
  283.     ret
  284. ENDP    put_sym
  285.  
  286. ;************************************************************************
  287. ;*    Convert page, displacement values to a long integer        *
  288. ;************************************************************************
  289. PROC C    make_ptr, @@page:WORD, @@disp:WORD
  290.     mov    dx, [@@page]
  291.     adjpage dx
  292.     mov    ax, [@@disp]
  293.     ret
  294. ENDP    make_ptr
  295.  
  296. ;************************************************************************
  297. ;* Allocate a cell for a fixnum (actually, return an immediate value)    *
  298. ;*    Calling sequence: alloc_fixnum(®, value)            *
  299. ;************************************************************************
  300. PROC C    alloc_fixnum, @@reg:WORD, @@val:WORD
  301.     mov    bx, [@@reg]
  302.     mov    ax, [@@val]
  303.     mov    [(REG bx).disp], ax
  304.     mov    [(REG bx).page], SPECFIX*2
  305.     ret
  306. ENDP    alloc_fixnum
  307.  
  308. ;************************************************************************
  309. ;*        Copy Variable Length Data Object            *
  310. ;*                                    *
  311. ;* Purpose: To create a copy of a variable length Scheme data object.    *
  312. ;*                                    *
  313. ;* Calling Sequence: copy_blk(&dest, &src)                *
  314. ;* where &dest:    address of VM register into which pointer to        *
  315. ;*            new copy is to be placed            *
  316. ;*    &src:    address of VM register containing block to be copied    *
  317. ;************************************************************************
  318. PROC C    copy_blk USES ds si di, @@dest:WORD, @@src:WORD
  319.     mov    si, [@@src]
  320.     mov    bx, [(REG si).page]
  321.     mov    di, [(REG si).disp]
  322.     ldpage    es, bx
  323.  
  324.     mov    ax, [(ANYDEF es:di).len]
  325.     or    ax, ax
  326.     jge    @@bigblock
  327.     add    ax, SIZE POINTER
  328.     jmp    @@cont
  329. @@bigblock:
  330.     sub    ax, OFFSET (TYPE ANYDEF).data
  331. @@cont:
  332.     xor    bx, bx            ; load type field from source block
  333.     mov    bl, [(ANYDEF es:di).tag]
  334.  
  335.     call    alloc_block C, [@@dest], bx, ax
  336.  
  337.     mov    bx, [@@dest]
  338.     mov    di, [(REG bx).disp]
  339.     mov    bx, [(REG bx).page]
  340.     ldpage    es, bx
  341.  
  342.     mov    bx, [@@src]
  343.     mov    si, [(REG bx).disp]
  344.     mov    bx, [(REG bx).page]
  345.     ldpage    ds, bx
  346.  
  347.     sstrlen    cx, <si>
  348.     lea    si, [(ANYDEF si).data]
  349.     lea    di, [(ANYDEF di).data]
  350.     cld
  351.     shr    cx, 1
  352.     rep    movsw
  353.     jnc    @@even
  354.     movsb
  355. @@even:
  356.     ret
  357. ENDP    copy_blk
  358.  
  359. ;************************************************************************
  360. ;*        C callable Routine to Take car/cdr of a List        *
  361. ;************************************************************************
  362. PROC C    take_car USES si, @@reg:WORD
  363.     mov    si, [@@reg]
  364.     mov    bx, [(REG si).page]
  365.     cmp    [ptype+bx], LISTTYPE
  366.     jne    take_error
  367.     ldpage    es, bx
  368.     mov    bx, [(REG si).disp]
  369.     mov    al, [(LISTDEF es:bx).car.page]
  370.     mov    bx, [(LISTDEF es:bx).car.disp]
  371. take_ok:
  372.     mov    [(REG si).bpage], al
  373.     mov    [(REG si).disp], bx
  374.     ret
  375. take_error:
  376.     xor    ax, ax
  377.     mov    [(REG si).page], ax
  378.     mov    [(REG si).disp], ax
  379.     ret
  380. ENDP    take_car
  381.  
  382. PROC C    take_cdr USES si, @@reg:WORD
  383.     mov    si, [@@reg]
  384.     mov    bx, [(REG si).page]
  385.     cmp    [ptype+bx], LISTTYPE
  386.     jne    take_error
  387.     ldpage    es, bx
  388.     mov    bx, [(REG si).disp]
  389.     mov    al, [(LISTDEF es:bx).cdr.page]
  390.     mov    bx, [(LISTDEF es:bx).cdr.disp]
  391.     jmp    take_ok
  392. ENDP    take_cdr
  393.  
  394. ;************************************************************************
  395. ;*            Symbol Hashing Routine                *
  396. ;*                                    *
  397. ;* Calling Seguence: hash_value = hash(symbol, len);            *
  398. ;************************************************************************
  399. PROC C    hash USES si, @@symbol:WORD, @@len:WORD
  400.     mov    si, [@@symbol]
  401.     mov    cx, [@@len]
  402.     xor    bx, bx
  403.     xor    ah, ah
  404.     jcxz    @@skiploop
  405. @@loop:
  406.     lodsb
  407.     add    bx, ax            ; sum them up
  408.     rol    bx, 1            ; complicate
  409.     loop    @@loop
  410. @@skiploop:
  411.     mov    ax, bx            ; copy sum of chars to ax
  412.     xor    dx, dx
  413.     mov    bx, HT_SIZE
  414.     div    bx
  415.     mov    ax, dx
  416.     ret
  417. ENDP    hash
  418.  
  419. ;************************************************************************
  420. ;*            Symbol Equality Routine                *
  421. ;*                                    *
  422. ;* Calling Sequence: equal? = sym_eq(page, disp, symbol, len);        *
  423. ;************************************************************************
  424. PROC C    sym_eq USES es si di, @@page:WORD, @@disp:WORD, @@symbol:WORD, @@len:WORD
  425.     mov    bx, [@@page]
  426.     shl    bx, 1            ; and adjust for word indexing
  427.     mov    di, [@@disp]
  428.     mov    si, [@@symbol]
  429.     mov    cx, [@@len]
  430.     ldpage    es, bx
  431.     mov    bx, [(SYMDEF es:di).len]
  432.     sub    bx, OFFSET (TYPE SYMDEF).buffer
  433.     cmp    cx, bx            ; length of symbol match?
  434.     jne    @@noteq
  435.     add    di, OFFSET (TYPE SYMDEF).buffer
  436.     repe    cmpsb
  437.     jne    @@noteq            ; symbols the same? if not, jump
  438.     mov    ax, 1            ; return equality
  439.     ret
  440. @@noteq:
  441.     xor    ax, ax            ; zero ax (return false value)
  442.     ret
  443. ENDP    sym_eq
  444.  
  445. ;************************************************************************
  446. ; Borland C callable routine to push a register onto Scheme's stack    *
  447. ; Calling Sequence:        C_push(c_reg)                *
  448. ; where:    REG c_reg: register (pointer/value) to push    *
  449. ;************************************************************************
  450. PROC C    c_push USES di, @@reg:WORD
  451. @@retry:                ; Process overflow-- copy contents of stack to the heap
  452.     mov    di, [topofstack]
  453.     cmp    di, STKSIZE-SIZE POINTER; test for overflow
  454.     jnge    @@alright
  455.     call    stk_ovfl C        ; copy the stack contents
  456.     jmp    @@retry
  457. @@alright:
  458.     add    di, SIZE POINTER
  459.     mov    [topofstack], di
  460.     mov    bx, [@@reg]
  461.     mov    dl, [(REG bx).bpage]
  462.     mov    ax, [(REG bx).disp]
  463.     mov    [(POINTER s_stack+di).page], dl
  464.     mov    [(POINTER s_stack+di).disp], ax
  465.     ret
  466. ENDP    c_push
  467.  
  468. ;************************************************************************
  469. ; Borland C callable routine to pop a register from Scheme's stack    *
  470. ; Calling Sequence:        C_pop(c_reg)                *
  471. ; where:    REG c_reg: register to hold the value popped    *
  472. ;************************************************************************
  473. PROC C    c_pop USES si, @@reg:WORD
  474.     mov    si, [topofstack]
  475.     lea    ax, [si-SIZE POINTER]
  476.     mov    [topofstack], ax
  477.     mov    bx, [@@reg]
  478.     mov    dl, [(POINTER s_stack+si).page]
  479.     mov    ax, [(POINTER s_stack+si).disp]
  480.     mov    [(REG bx).bpage], dl
  481.     mov    [(REG bx).disp], ax
  482.     ret
  483. ENDP    c_pop
  484.  
  485. ;************************************************************************
  486. ;*            C-callable Fluid Variable Lookup        *
  487. ;*                                    *
  488. ;* Purpose: To retrieve the fluid binding for a variable.        *
  489. ;*                                    *
  490. ;* Calling Sequence:    stat = fluid_lookup(®)            *
  491. ;* where ®:    address of the register containing the symbol to be    *
  492. ;*        looked up.                        *
  493. ;*        On exit, "reg" contains the current binding for the    *
  494. ;*        symbol,    if found.                    *
  495. ;*    stat:    search status:    TRUE=symbol found            *
  496. ;*                FALSE=symbol not found            *
  497. ;*                                    *
  498. ;* Note: If the call to "lookup" doesn't find the desired symbol, it    *
  499. ;*        will return a nil pointer. It is correct to always    *
  500. ;*        return the cdr of the pointer "lookup" returns, since    *
  501. ;*        the cdr of nil is itself nil-- a valid value.        *
  502. ;************************************************************************
  503. PROC C    fluid_lookup USES si di, @@reg:WORD
  504.     mov    bx, [@@reg]
  505.     mov    ax, [(REG bx).disp]
  506.     mov    dl, [(REG bx).bpage]
  507.     mov    bx, [fnv_reg.page]
  508.     mov    si, [fnv_reg.disp]
  509.     call    lookup            ; search the fluid environment for the symbol
  510.     mov    si, [@@reg]        ; store "cdr" of returned cell into register
  511.     mov    dl, [(LISTDEF es:di).cdr.page]
  512.     mov    ax, [(LISTDEF es:di).cdr.disp]
  513.     mov    [(REG si).bpage], dl
  514.     mov    [(REG si).disp], ax
  515.     mov    ax, bx            ; set return code (bx=0 if symbol not found)
  516.     ret
  517. ENDP    fluid_lookup
  518.  
  519. ;************************************************************************
  520. ;*                CPUTYPE    and CPUSPEED            *
  521. ;*                                    *
  522. ;* Purpose: To determine to cpu type (8086, '186, '286, '386 etc.)    *
  523. ;*    and the processor's speed in MHz.                *
  524. ;* CPUSPEED accepts two arguments, pointers to registers        *
  525. ;************************************************************************
  526. PROC C    cputype USES es si, @@type:WORD, @@speed:WORD
  527.     xor    ax, ax
  528.     mov    es, ax
  529.     mov    si, 46ch        ; es:si is timer's address
  530.  
  531.     action    <8086 ? >
  532.     pushf
  533.     pop    bx            ; try clearing bits 12-15
  534.     and    bx, 0fffh
  535.     push    bx
  536.     popf
  537.     pushf
  538.     pop    cx
  539.     and    cx, 0f000h        ; if set, then it's a 8086
  540.     cmp    cx, 0f000h
  541.     jne    @@not8086
  542.     jmp    @@8086
  543. @@not8086:
  544.     action    <80286 ? >
  545.     or    bx, 0f000h        ; now try to set them
  546.     push    bx
  547.     popf
  548.     pushf
  549.     pop    bx
  550.     and    bx, 0f000h        ; if they're all clear, then it's a 286
  551.     jnz    @@32bit
  552.  
  553.     action    <Measuring',13,10,'>
  554.     mov    bx, [@@type]
  555.     mov    [(REG bx).disp], 286
  556.  
  557.     xor    cx, cx
  558.     mov    bx, [WORD es:si]    ; read the timer
  559. @@start286:
  560.     cmp    [WORD es:si], bx
  561.     je    @@start286        ; wait for a clock rise
  562.     mov    bx, [WORD es:si]    ; wait for the next one
  563. @@speed286:
  564.     inc    cx            ; 2
  565.     mul    ax            ; ax is 0, so timing=24
  566.     cmp    [WORD es:si], bx    ; 7
  567.     je    @@speed286        ; 7
  568.     mov    ax, cx
  569.     add    ax, 687
  570.     mov    cx, 1374        ; 1000000 / (18.2 * 40)
  571.     div    cx
  572.     jmp    @@return
  573. @@32bit:
  574. P386
  575.     action    <80386 ? >
  576.     mov    edx, esp
  577.     and    esp, not 3        ; avoid stack faults
  578.     pushfd
  579.     pop    eax
  580.     mov    ecx, eax
  581.     xor    eax, 40000h        ; flip the Align-Check bit
  582.     push    eax
  583.     popfd
  584.     pushfd
  585.     pop    eax
  586.     xor    eax, ecx
  587.     push    ecx
  588.     popfd
  589.     mov    esp, edx
  590.     and    eax, 40000h        ; if flags didn't change there,
  591.     jz    @@386            ; alignment check is usupported.
  592.  
  593.     action    <80486. Measuring',13,10,'>
  594.     mov    bx, [@@type]
  595.     mov    [(REG bx).disp], 486
  596.     xor    cx, cx
  597.     mov    bx, [WORD es:si]    ; read the timer
  598. @@start486:
  599.     cmp    [WORD es:si], bx
  600.     je    @@start486        ; wait for a clock rise
  601.     mov    bx, [WORD es:si]    ; wait for the next one
  602. @@speed486:
  603.     inc    cx            ; 1
  604.     imul    eax, eax, 80000000h    ; worst case: 42
  605.     imul    eax, eax, 80000000h
  606.     cmp    [WORD es:si], bx    ; 2
  607.     je    @@speed486        ; 3
  608.     mov    ax, cx
  609.     add    ax, 305
  610.     mov    cx, 610            ; 1000000 / (18.2 * 90)
  611.     xor    dx, dx
  612.     div    cx
  613.     jmp    @@return
  614. @@386:
  615.     action    <Measuring',13,10,'>
  616.     mov    bx, [@@type]
  617.     mov    [(REG bx).disp], 386
  618.     xor    cx, cx
  619.     mov    bx, [WORD es:si]    ; read the timer
  620. @@start386:
  621.     cmp    [WORD es:si], bx
  622.     je    @@start386        ; wait for a clock rise
  623.     mov    bx, [WORD es:si]    ; wait for the next one
  624. @@speed386:
  625.     inc    cx            ; 2
  626.     imul    eax, eax, 80000000h    ; worst case: 38
  627.     cmp    [WORD es:si], bx    ; 5
  628.     je    @@speed386        ; 7
  629.     mov    ax, cx
  630.     add    ax, 528
  631.     mov    cx, 1057        ; 1000000 / (18.2 * 52)
  632.     xor    dx, dx
  633.     div    cx
  634.     jmp    @@return
  635. P8086
  636. @@8086:                    ; just for fun, let's see if the data
  637.     action    <Measuring',13,10,'>    ; path is 8 or 16 bits
  638.     xor    dx, dx            
  639.     mov    bx, [WORD es:si]    ; read the timer
  640. @@start86:
  641.     cmp    [WORD es:si], bx
  642.     je    @@start86        ; wait for a clock rise
  643.     mov    bx, [WORD es:si]    ; wait for the next one
  644. @@loop16:
  645.     inc    ax            ; 2
  646.     cmp    [WORD es:si], bx    ; 4 * (14..18)
  647.     cmp    [WORD es:si], bx
  648.     cmp    [WORD es:si], bx
  649.     cmp    [WORD es:si], bx
  650.     je    @@loop16        ; 16
  651.     inc    bx            ; go for another one
  652. @@loop8:
  653.     inc    dx
  654.     cmp    [BYTE es:si], bl
  655.     cmp    [BYTE es:si], bl
  656.     cmp    [BYTE es:si], bl
  657.     cmp    [BYTE es:si], bl
  658.     je    @@loop8            ; now dx should be 90/74 ax
  659.  
  660.     mov    si, [@@type]
  661.     mov    bx, dx
  662.     sub    dx, ax
  663.     idiv    ax
  664.     cmp    ax, 7000        ; more than 10% below ?
  665.     jl    @@16bit
  666.     mov    [(REG si).disp], 88
  667.     jmp    @@speed86
  668. @@16bit:
  669.     mov    [(REG si).disp], 86
  670. @@speed86:
  671.     mov    ax, bx
  672.     add    ax, 371            ; half for roundoffs
  673.     mov    bx, 742            ; 1000000 / (74 * 18.21)
  674.     xor    dx, dx
  675.     div    bx
  676. @@return:
  677.     action    <Leaving CPU test subroutine',13,10,'>
  678.     mov    si, [@@speed]
  679.     mov    [(REG si).disp], ax
  680.     ret
  681. ENDP    cputype
  682.  
  683.     END
  684.